home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / mail.arc / MAIL1.BAS (.txt) next >
Encoding:
GW-BASIC  |  1985-09-18  |  20.3 KB  |  551 lines
  1. 0   GOTO 2
  2. 1  SAVE"MAIL1.BAS":STOP
  3. 2  '
  4. 5  '
  5. 10  '    0-1-3 0 103.-1-1*************************
  6. 20  '   ***     MAILING LIST PROGRAM   v.1.0   ***
  7. 30  '   ******************************************
  8. 40  '
  9. 50  '   by Joe Long                       for IBM PC
  10. 60  '   Rt. 1 Box 100                     up to 1,000 records
  11. 70  '   Madison, AL  35758
  12. 75  '
  13. 80  '               ***    Copyright 1983 by Joe Long   ***
  14. 85  '   ** Permission to copy for private use and FREE distribution granted   **
  15. 90  '
  16. 100  DEFINT A-Z : DIM SORT$(1000), SORT(1000), FILL$(50), FRERECNUM$(50)
  17. 110  ON ERROR GOTO 9900
  18. 120  FG=7 : BG=0 : BD=0 : HI = 15  '   Color variables
  19. 130  COLOR FG,BG,BD : KEY OFF : CLS
  20. 140  ON KEY(1) GOSUB 2000: ON KEY(2) GOSUB 3000: ON KEY(3) GOSUB 4000: ON KEY(4) GOSUB 5000: ON KEY(5) GOSUB 4200: ON KEY(6) GOSUB 4400: ON KEY(7) GOSUB 4600: ON KEY(8) GOSUB 4800: ON KEY(9) GOSUB 500: ON KEY(10) GOSUB 400
  21. 150  KEY(1) ON: KEY(2) ON: KEY(3) ON: KEY(4) ON: KEY(5) ON: KEY(6) ON: KEY(7) ON: KEY(8) ON: KEY(9) ON: KEY(10) ON
  22. 155  DRIVE$="B:" ' Change for different data drive - Mod by A. Lantos 10/27/84
  23. 160  OPEN "R",1,DRIVE$+"MAILLIST.TXT"
  24. 170  FIELD 1, 20 AS SCRDATA$(1), 1 AS SCRDATA$(2), 16 AS SCRDATA$(3), 34 AS SCRDATA$(4), 18 AS SCRDATA$(5), 2 AS SCRDATA$(6), 5 AS SCRDATA$(7), 16 AS SCRDATA$(8), 8 AS SCRDATA$(9), 8 AS SCRDATA$(10)
  25. 175  FIELD 1, 20 AS FILL$, 1 AS SORTFLAG$, 107 AS FILLER$
  26. 176  FOR I = 1 TO 50
  27. 177    FIELD 1, 19 + 2*I AS FILL$(I), 2 AS FRERECNUM$(I)
  28. 178  NEXT I
  29. 180  OPEN "R",2,DRIVE$+"NAMEINDX.TXT",18
  30. 190  FIELD 2, 16 AS NAMEINDEX$, 2 AS NAMERECORD$
  31. 200  OPEN "R",3,DRIVE$+"ZIPINDEX.TXT",7
  32. 210  FIELD 3, 5 AS ZIPINDEX$, 2 AS ZIPRECORD$
  33. 220  OPEN "R",4,DRIVE$+"CITYINDX.TXT",20
  34. 230  FIELD 4, 18 AS CITYINDEX$, 2 AS CITYRECORD$
  35. 240  OPEN "R",5,DRIVE$+"STATEIDX.TXT",4
  36. 250  FIELD 5, 2 AS STATEINDEX$, 2 AS STATERECORD$
  37. 260  GET 1,1
  38. 270  IF FILL$ = "                    " THEN 300
  39. 280  LSET FILL$ = "" : LSET SORTFLAG$ = "" : LSET FILLER$ = ""
  40. 290  PUT 1,1
  41. 300  IF ASC(SORTFLAG$) = 2 THEN 350
  42. 310  PRINT : PRINT "The file has been modified since last sorted."
  43. 320  PRINT : PRINT "Do you want to sort the index files? ";
  44. 330  GOSUB 9100
  45. 340  IF YES = 1 THEN GOSUB 3000
  46. 350  GOTO 1000
  47. 390  '
  48. 400  '   ***   Ending Routine   ***
  49. 410  '
  50. 420  LOCATE 22,10 : COLOR FG,BG : PRINT "Do you really want to end the program? ";
  51. 430  GOSUB 9100
  52. 440  IF YES = 0 THEN MENU = 0 : LOCATE 22,10 : PRINT STRING$(70," ") : RETURN
  53. 450  CLS : PRINT : PRINT TAB(36) "End of program." : PRINT
  54. 460  END
  55. 500  '   ***   Restart routine   ***
  56. 510  '
  57. 520  CLOSE : RUN
  58. 980  '
  59. 990  '    ******************************
  60. 1000  '   ***   MAIN MENU ROUTINES   ***
  61. 1010  '   ******************************
  62. 1015  '
  63. 1020  CLS : PRINT : PRINT TAB(30) "MAILLIST Main Menu"
  64. 1030  PRINT : PRINT TAB(10) "Key" : PRINT TAB(54) "Function"
  65. 1040  PRINT TAB(10)"---" : PRINT TAB(50) "----------------"
  66. 1050  PRINT : PRINT TAB(10)"F1"; : PRINT TAB(50) "Add name to list"
  67. 1070  PRINT : PRINT TAB(10)"F2"; : PRINT TAB(50) "Sort list"
  68. 1080  PRINT : PRINT TAB(10)"F3"; : PRINT TAB(50) "Search/edit record"
  69. 1090  PRINT : PRINT TAB(10)"F4"; : PRINT TAB(50) "Print labels"
  70. 1100  PRINT : PRINT TAB(10)"F10"; : PRINT TAB(50) "Exit program"
  71. 1110  MENU=1
  72. 1120  IF MENU=1 THEN GOTO 1120 ELSE GOTO 1000
  73. 1480  '
  74. 1490  '   **************************************************************
  75. 1500  '   ***   Maintain list of free (deleted) records for re-use   ***
  76. 1510  '   **************************************************************
  77. 1590  '
  78. 1600  '   ***   Find free record   ***
  79. 1610  '
  80. 1620  GET 1,1
  81. 1630  FOR I = 50 TO 1 STEP -1
  82. 1640    IF FRERECNUM$(I) <> "  " THEN 1690
  83. 1650  NEXT I
  84. 1660  RECORD = LOF(1)/128 + 1 : TRIAL = RECORD
  85. 1670  RETURN
  86. 1690  RECORD = CVI(FRERECNUM$(I))
  87. 1700  TRIAL = LOF(1)/128 : GET 2, TRIAL      '   Find free index record
  88. 1710  WHILE NAMEINDEX$ = "________________"
  89. 1720  TRIAL = TRIAL - 1
  90. 1730  GET 2, TRIAL
  91. 1740    WEND
  92. 1750  LSET FRERECNUM$(I) = "" : PUT 1,1   '  delete stored record #
  93. 1760  RETURN
  94. 1790  '
  95. 1800  '   ***   Store deleted record number   ***
  96. 1810  '
  97. 1820  GET 1,1
  98. 1830  FOR I = 1 TO 50
  99. 1840    IF FRERECNUM$(I) = "  " THEN 1870
  100. 1850  NEXT I
  101. 1860  RETURN   '   discard if 50 free records stored
  102. 1870  LSET FRERECNUM$(I) = MKI$(RECORD)
  103. 1880  PUT 1,1
  104. 1890  RETURN
  105. 1980  '
  106. 1990  '   *****************************
  107. 2000  '   ***   Add names to list   ***
  108. 2010  '   *****************************
  109. 2020  '
  110. 2030  MENU=0
  111. 2040  GOSUB 1500     '   get next record #
  112. 2050  GOSUB 8100     '   Print blank form on screen
  113. 2060  RESTORE : READ DUMMY, DUMMY, DUMMY   '   set data for cursor advance
  114. 2070  ROW=4 : COL=13      '   set initial cursor location
  115. 2080  GOSUB 8500
  116. 2090  RESTORE : GOSUB 8800
  117. 2110  GOSUB 6100                '   Save to disc
  118. 2120  RETURN
  119. 2980  '
  120. 2990  '   ************************
  121. 3000  '   ***   Sort Indexes   ***
  122. 3010  '   ************************
  123. 3015  '
  124. 3020  MENU = 0
  125. 3030  LASTRECORD = LOF(1)/128
  126. 3040  CLS : PRINT "Reading last name index file."
  127. 3090  '
  128. 3100  '   ***   Sort Name Index    ***
  129. 3110  '
  130. 3120  FOR I = 1 TO LASTRECORD
  131. 3130    GET 2,I : SORT$(I) = NAMEINDEX$ : SORT(I) = CVI(NAMERECORD$)
  132. 3140  NEXT I
  133. 3150  PRINT "Last name index read ... now sorting last name index."
  134. 3160  GOSUB 9400
  135. 3170  PRINT "Sorting complete ... now writing sorted last name index."
  136. 3180  FOR I = 1 TO LASTRECORD
  137. 3190    LSET NAMEINDEX$ = SORT$(I) : LSET NAMERECORD$ = MKI$(SORT(I))
  138. 3200    PUT 2,I
  139. 3210  NEXT I
  140. 3220  PRINT "Last name index file written ... now reading zip code index file."
  141. 3290  '
  142. 3300  '   ***   Sort zip code index   ***
  143. 3310  '
  144. 3320  FOR I = 1 TO LASTRECORD
  145. 3330    GET 3,I : SORT$(I) = ZIPINDEX$ : SORT(I) = CVI(ZIPRECORD$)
  146. 3340  NEXT I
  147. 3350  PRINT "Zip code index file read ... now sorting zip code index."
  148. 3360  GOSUB 9400
  149. 3370  PRINT "Sorting complete ... now writing sorted zip code index file."
  150. 3380  FOR I = 1 TO LASTRECORD
  151. 3390    LSET ZIPINDEX$ = SORT$(I) : LSET ZIPRECORD$ = MKI$(SORT(I))
  152. 3400    PUT 3,I
  153. 3410  NEXT I
  154. 3420  PRINT "Zip code index file written ... reading City index file."
  155. 3490  '
  156. 3500  '   ***   Sort City Index   ***
  157. 3510  '
  158. 3520  FOR I = 1 TO LASTRECORD
  159. 3530    GET 4,I : SORT$(I) = CITYINDEX$ : SORT(I) = CVI(CITYRECORD$)
  160. 3540  NEXT I
  161. 3550  PRINT "City index file read ... now sorting City index."
  162. 3560  GOSUB 9400
  163. 3570  PRINT "Sorting complete ... now writing sorted City index file."
  164. 3580  FOR I = 1 TO LASTRECORD
  165. 3590    LSET CITYINDEX$ = SORT$(I) : LSET CITYRECORD$ = MKI$(SORT(I))
  166. 3600    PUT 4,I
  167. 3610  NEXT I
  168. 3620  PRINT "City index file written ... reading State index file."
  169. 3690  '
  170. 3700  '   ***   Sort State index   ***
  171. 3710  '
  172. 3720  FOR I = 1 TO LASTRECORD
  173. 3730    GET 5,I : SORT$(I) = STATEINDEX$ : SORT(I) = CVI(STATERECORD$)
  174. 3740  NEXT I
  175. 3750  PRINT "State index file read ... now sorting State index file."
  176. 3760  GOSUB 9400
  177. 3770  PRINT "Sorting complete ... now writing sorted State index file."
  178. 3780  FOR I = 1 TO LASTRECORD
  179. 3790    LSET STATEINDEX$ = SORT$(I) : LSET STATERECORD$ = MKI$(SORT(I))
  180. 3800    PUT 5,I
  181. 3810  NEXT I
  182. 3820  BEEP : PRINT "State index file written ... all sorting completed."
  183. 3830  LSET FILL1$ = "" : LSET SORTFLAG$ = CHR$(2) : LSET FILL2$ = ""
  184. 3840  PUT 1,1
  185. 3850  FOR I = 1 TO 1000 : NEXT I
  186. 3860  RETURN
  187. 3980  '
  188. 3990  '   ***********************************
  189. 4000  '   ***   Search and Edit Records   ***
  190. 4010  '   ***********************************
  191. 4020  '
  192. 4030  LASTRECORD = LOF(1)/128
  193. 4090  '
  194. 4100  '   ***   Search Menu   ***
  195. 4110  '
  196. 4120  CLS : MENU = 1 : PRINT : PRINT TAB(10) "Key";: PRINT TAB(50) "Type of Search"
  197. 4130  PRINT TAB(10) "___";: PRINT TAB(50) "______________"
  198. 4140  PRINT : PRINT TAB(11) "F5";: PRINT TAB(50) "Last Name"
  199. 4150  PRINT : PRINT TAB(11) "F6";: PRINT TAB(50) "Zip Code"
  200. 4160  PRINT : PRINT TAB(11) "F7";: PRINT TAB(50) "City"
  201. 4170  PRINT : PRINT TAB(11) "F8";: PRINT TAB(50) "State"
  202. 4180  PRINT : PRINT TAB(11) "F9";: PRINT TAB(50) "Return to Main Menu"
  203. 4190  IF MENU = 1 THEN GOTO 4190 ELSE MENU = 1 : GOTO 4120
  204. 4195  '
  205. 4200  '   ***   Search by last name   ***
  206. 4210  '
  207. 4220  CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  208. 4240  PRINT : INPUT "Last name for search"; LASTNAME$
  209. 4250  NAMELENGTH = LEN(LASTNAME$)
  210. 4260  LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  211. 4270  TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  212. 4280  GET 2, TRIAL : RECORD = CVI(NAMERECORD$)
  213. 4290  IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4340
  214. 4300  IF NAMEINDEX$ < LASTNAME$ THEN LOWLIMIT = TRIAL
  215. 4310  IF NAMEINDEX$ > LASTNAME$ THEN HIGHLIMIT = TRIAL
  216. 4320  NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  217. 4330  IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4280
  218. 4340  MATCH = TRIAL
  219. 4350  TRIAL = TRIAL - 1 : GET 2, TRIAL : RECORD = CVI(NAMERECORD$) : IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4350
  220. 4360  TRIAL = MATCH
  221. 4370  TRIAL = TRIAL + 1 : GET 2, TRIAL : RECORD = CVI(NAMERECORD$) : IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4370
  222. 4380  BEEP : PRINT "No more entries by that name." : FOR I = 1 TO 500 : NEXT I : RETURN
  223. 4390  '
  224. 4400  '   ***   Search by zip code   ***
  225. 4410  '
  226. 4420  CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  227. 4440  PRINT : INPUT "Zip code for search"; ZIPCODE$
  228. 4460  LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  229. 4470  TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  230. 4480  GET 3, TRIAL : RECORD = CVI(ZIPRECORD$)
  231. 4490  IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4540
  232. 4500  IF ZIPINDEX$ < ZIPCODE$ THEN LOWLIMIT = TRIAL
  233. 4510  IF ZIPINDEX$ > ZIPCODE$ THEN HIGHLIMIT = TRIAL
  234. 4520  NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  235. 4530  IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4480
  236. 4540  MATCH = TRIAL
  237. 4550  TRIAL = TRIAL - 1 : GET 3, TRIAL : RECORD = CVI(ZIPRECORD$) : IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4550
  238. 4560  TRIAL = MATCH
  239. 4570  TRIAL = TRIAL + 1 : GET 3, TRIAL : RECORD = CVI(ZIPRECORD$) : IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4570
  240. 4580  BEEP : PRINT "No more entries with that number." : FOR I = 1 TO 500 : NEXT I : RETURN
  241. 4590  '
  242. 4600  '   ***   Search by City   ***
  243. 4610  '
  244. 4620  CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  245. 4640  PRINT : INPUT "City for search"; CITY$
  246. 4650  CITYLENGTH = LEN(CITY$)
  247. 4660  LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  248. 4670  TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  249. 4680  GET 4, TRIAL : RECORD = CVI(CITYRECORD$)
  250. 4690  IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4740
  251. 4700  IF CITYINDEX$ < CITY$ THEN LOWLIMIT = TRIAL
  252. 4710  IF CITYINDEX$ > CITY$ THEN HIGHLIMIT = TRIAL
  253. 4720  NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  254. 4730  IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4680
  255. 4740  MATCH = TRIAL
  256. 4750  TRIAL = TRIAL - 1 : GET 4, TRIAL : RECORD = CVI(CITYRECORD$) : IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4750
  257. 4760  TRIAL = MATCH
  258. 4770  TRIAL = TRIAL + 1 : GET 4, TRIAL : RECORD = CVI(CITYRECORD$) : IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4770
  259. 4780  BEEP : PRINT "No more entries with that city." : FOR I = 1 TO 500 : NEXT I : RETURN
  260. 4790  '
  261. 4800  '   ***   Search by State   ***
  262. 4810  '
  263. 4820  CLS : MENU = 0 : LASTRECORD = LOF(1)/128
  264. 4840  PRINT : INPUT "State for search"; STATE$
  265. 4860  LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
  266. 4870  TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  267. 4880  GET 5, TRIAL : RECORD = CVI(STATERECORD$)
  268. 4890  IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4940
  269. 4900  IF STATEINDEX$ < STATE$ THEN LOWLIMIT = TRIAL
  270. 4910  IF STATEINDEX$ > STATE$ THEN HIGHLIMIT = TRIAL
  271. 4920  NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
  272. 4930  IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4880
  273. 4940  MATCH = TRIAL
  274. 4950  TRIAL = TRIAL - 1 : GET 5, TRIAL : RECORD = CVI(STATERECORD$) : IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4950
  275. 4960  TRIAL = MATCH
  276. 4970  TRIAL = TRIAL + 1 : GET 5, TRIAL : RECORD = CVI(STATERECORD$) : IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4970
  277. 4980  BEEP : PRINT "No more entries with that state." : FOR I = 1 TO 500 : NEXT I : RETURN
  278. 4985  '
  279. 4990  '   ************************
  280. 5000  '   ***   Print Labels   ***
  281. 5010  '   ************************
  282. 5020  '
  283. 5030  MENU = 0 : CLS
  284. 5040  PRINT : INPUT "One or two across"; LABELNUMBER
  285. 5050  IF LABELNUMBER < 1 OR LABELNUMBER > 2 THEN PRINT : PRINT "This program only prints one or two 3 1/2"; CHR$(34); "labels per row, choose (1) or (2) please." : GOTO 5040
  286. 5060  GOSUB 9200     '   Select key field
  287. 5070  PRINT : PRINTKEY$ = "" : INPUT "Key to print (or <enter> to print all)"; PRINTKEY$ : IF PRINTKEY$ = "" THEN PRINTKEY$ = "*"
  288. 5075  PRINT : PRINT "Print phone numbers? "; : GOSUB 9100
  289. 5078  IF YES = 1 THEN PHONEFLAG = 1 ELSE PHONEFLAG = 0
  290. 5080  IF LABELNUMBER = 2 THEN GOTO 5400
  291. 5090  '
  292. 5100  '   ***   Print one across labels   ***
  293. 5110  '
  294. 5120  LASTRECORD = LOF(1)/128
  295. 5130  RECORD = 0
  296. 5140  IF RECORD = LASTRECORD THEN RETURN ELSE RECORD = RECORD + 1 : GOSUB 6300    '   get next record
  297. 5150  IF KEYFIELD < 9 THEN GOTO 5240
  298. 5160  FOR I = 1 TO 8
  299. 5170    FOR J = 1 TO LEN(PRINTKEY$)
  300. 5180      IF MID$(SCREENDATA$(KEYFIELD),I,1) = MID$(PRINTKEY$,J,1) THEN GOTO 5300
  301. 5190    NEXT J
  302. 5200  NEXT I
  303. 5220  GOTO 5140
  304. 5240  IF PRINTKEY$ = "*" THEN 5300
  305. 5250   FIELDDATA$(KEYFIELD) = LEFT$(SCREENDATA$(KEYFIELD),LEN(PRINTKEY$))
  306. 5260  IF FIELDDATA$(KEYFIELD) <> PRINTKEY$ THEN GOTO 5140
  307. 5300  LPRINT : LPRINT SCREENDATA$(1);" ";
  308. 5310  IF SCREENDATA$(2) <> "" THEN LPRINT SCREENDATA$(2);". ";
  309. 5320  LPRINT SCREENDATA$(3)
  310. 5330  LPRINT SCREENDATA$(4)
  311. 5340  LPRINT SCREENDATA$(5); ", "; SCREENDATA$(6); : LPRINT TAB(25); SCREENDATA$(7)
  312. 5350  IF PHONEFLAG = 1 THEN LPRINT SCREENDATA$(8) ELSE LPRINT
  313. 5360  LPRINT
  314. 5370  GOTO 5140
  315. 5390  '
  316. 5400  '   ***   Print two across labels   ***
  317. 5410  '
  318. 5420  LASTRECORD = LOF(1)/128 : RECORD = 0 : LEFTLABEL = 1
  319. 5430  IF RECORD >= LASTRECORD THEN 5800
  320. 5440  RECORD = RECORD + 1 : GOSUB 6300   '   get next record
  321. 5450  IF KEYFIELD < 9 THEN GOTO 5540
  322. 5460  FOR I = 1 TO 8
  323. 5470    FOR J = 1 TO LEN(PRINTKEY$)
  324. 5480      IF MID$(SCREENDATA$(KEYFIELD),I,1) = MID$(PRINTKEY$,J,1) THEN GOTO 5600
  325. 5490    NEXT J
  326. 5500  NEXT I
  327. 5520  GOTO 5430
  328. 5540  IF PRINTKEY$ = "*" THEN 5600
  329. 5550   FIELDDATA$(KEYFIELD) = LEFT$(SCREENDATA$(KEYFIELD),LEN(PRINTKEY$))
  330. 5560  IF FIELDDATA$(KEYFIELD) <> PRINTKEY$ THEN GOTO 5440
  331. 5600  IF LEFTLABEL = 0 THEN 5700
  332. 5610  FOR I = 1 TO 8
  333. 5620    LABELDATA$(I) = SCREENDATA$(I)
  334. 5630  NEXT I
  335. 5640  LEFTLABEL = 0
  336. 5650  GOTO 5430
  337. 5700  LPRINT : LPRINT LABELDATA$(1); " "; : IF LABELDATA$(2) <> "" THEN LPRINT LABELDATA$(2); ". ";
  338. 5710  LPRINT LABELDATA$(3);
  339. 5720  LPRINT TAB(37) SCREENDATA$(1); " "; : IF SCREENDATA$(2) <> "" THEN LPRINT SCREENDATA$(2); ". ";
  340. 5730  LPRINT SCREENDATA$(3)
  341. 5740  LPRINT LABELDATA$(4); : LPRINT TAB(37) SCREENDATA$(4)
  342. 5750  LPRINT LABELDATA$(5); ", "; LABELDATA$(6); : LPRINT TAB(25) LABELDATA$(7);
  343. 5760  LPRINT TAB(37) SCREENDATA$(5); ", "; SCREENDATA$(6); : LPRINT TAB(62) SCREENDATA$(7)
  344. 5770  IF PHONEFLAG = 1 THEN LPRINT LABELDATA$(8); : LPRINT TAB(37) SCREENDATA$(8) ELSE LPRINT
  345. 5780  LPRINT : LEFTLABEL = 1 : GOTO 5430
  346. 5790  '
  347. 5800  '   ***   Print odd remaining label   ***
  348. 5810  '
  349. 5820  IF LEFTLABEL = 1 THEN RETURN
  350. 5830  LPRINT : LPRINT LABELDATA$(1); " "; : IF LABELDATA$(2) <> "" THEN LPRINT LABELDATA$(2); ". ";
  351. 5840  LPRINT LABELDATA$(3)
  352. 5850  LPRINT LABELDATA$(4)
  353. 5860  LPRINT LABELDATA$(5); ", "; LABELDATA$(6); : LPRINT TAB(25) LABELDATA$(7)
  354. 5870  IF PHONEFLAG = 1 THEN LPRINT LABELDATA$(8) : LPRINT ELSE LPRINT : LPRINT
  355. 5890  RETURN
  356. 5980  '
  357. 5990  '   *****************************
  358. 6000  '   ***   MAIN I/O ROUTINES   ***
  359. 6010  '   *****************************
  360. 6090  '
  361. 6100  '   ***   Write Record to File   ***
  362. 6110  '
  363. 6140  FOR I=1 TO 10
  364. 6150    LSET SCRDATA$(I) = SCREENDATA$(I)
  365. 6160  NEXT I
  366. 6170  PUT 1, RECORD
  367. 6180  LSET NAMEINDEX$ = SCREENDATA$(3) : LSET NAMERECORD$ = MKI$(RECORD)
  368. 6190  PUT 2, TRIAL
  369. 6200  LSET ZIPINDEX$ = SCREENDATA$(7) : LSET ZIPRECORD$ = MKI$(RECORD)
  370. 6210  PUT 3, TRIAL
  371. 6220  LSET CITYINDEX$ = SCREENDATA$(5) : LSET CITYRECORD$ = MKI$(RECORD)
  372. 6230  PUT 4, TRIAL
  373. 6240  LSET STATEINDEX$ = SCREENDATA$(6) : LSET STATERECORD$ = MKI$(RECORD)
  374. 6250  PUT 5, TRIAL
  375. 6260  GET 1,1
  376. 6270  LSET FILL$ = "" : LSET SORTFLAG$ = ""
  377. 6280  PUT 1,1 : RETURN
  378. 6290  '
  379. 6300  '   ***   Read Record from File   ***
  380. 6310  '
  381. 6330  GET 1, RECORD
  382. 6340  FOR I = 1 TO 10
  383. 6350    SCREENDATA$(I) = SCRDATA$(I)
  384. 6360    FOR J = LEN(SCREENDATA$(I)) TO 1 STEP -1
  385. 6370      IF MID$(SCREENDATA$(I),J,1) <> "_" THEN 6400
  386. 6380    NEXT J
  387. 6390    SCREENDATA$(I) = ""   '   change blank string to null string
  388. 6400    SCREENDATA$(I) = LEFT$(SCREENDATA$(I),J)
  389. 6410  NEXT I
  390. 6420  RETURN
  391. 7980  '
  392. 7990  '   ***********************************
  393. 8000  '   ***   Display I/O Subroutines   ***
  394. 8010  '   ***********************************
  395. 8090  '
  396. 8100  '   ***   Print Form on Screen   ***
  397. 8110  '
  398. 8120  CLS : PRINT : PRINT TAB(20) "Record Number"; RECORD
  399. 8130  PRINT : PRINT "First Name: ";STRING$(20,"_"); "     M.I.: __     Last Name: ";STRING$(16,"_")
  400. 8140  PRINT : PRINT "Address: "; STRING$(34,"_")
  401. 8150  PRINT : PRINT "City: "; STRING$(18,"_"); "     State: __     Zip: "; STRING$(5,"_")
  402. 8160  PRINT : PRINT "Phone: ";STRING$(16,"_")
  403. 8170  PRINT : PRINT "Activity Key: "; STRING$(8,"_")
  404. 8180  PRINT : PRINT "Membership Key: ";STRING$(8,"_")
  405. 8190  PRINT : PRINT : PRINT TAB(22) "(Press <Esc> to delete record)"
  406. 8200  PRINT : PRINT TAB(12) "(Forward tab to next item, <Enter> to exit form)"
  407. 8210  RETURN
  408. 8390  '
  409. 8400  '   ***   Print Data on Screen   ***
  410. 8410  '
  411. 8420  COLOR HI, BG
  412. 8430  FOR I = 1 TO 10
  413. 8440    READ ROWDATA, COLDATA, LENDATA
  414. 8450    LOCATE ROWDATA,COLDATA : PRINT SCREENDATA$(I);
  415. 8460  NEXT I
  416. 8470  RETURN
  417. 8490  '
  418. 8500  '   ***   Process Keyboard Inputs to Screen  ***
  419. 8510  '
  420. 8520  COLORVAL = SCREEN(ROW,COL,1) : COLORFORE = (COLORVAL MOD 16) : CHARACTER = SCREEN(ROW,COL)
  421. 8530  LOCATE ROW,COL : COLOR BG,COLORFORE : PRINT CHR$(CHARACTER);
  422. 8540  FOR I = 1 TO 30
  423. 8550    DATUM$ = INKEY$ : IF DATUM$ <> "" THEN GOTO 8620
  424. 8560  NEXT I
  425. 8570  LOCATE ROW,COL : COLOR COLORFORE,BG : PRINT CHR$(SCREEN(ROW,COL));
  426. 8580  FOR I = 1 TO 30
  427. 8590    DATUM$ = INKEY$ : IF DATUM$ <> "" THEN GOTO 8620
  428. 8600  NEXT I
  429. 8610  GOTO 8530
  430. 8620  LOCATE ROW,COL : COLOR COLORFORE,BG : PRINT CHR$(SCREEN(ROW,COL));
  431. 8625  IF ASC(DATUM$) = 27 THEN 9600     '   delete entry
  432. 8630  IF LEN(DATUM$) = 1 THEN GOTO 8700
  433. 8640  CURMOVE = ASC(RIGHT$(DATUM$,1))
  434. 8650  IF CURMOVE = 77 THEN COL = COL + 1 : IF COL > 80 THEN COL = 1 : ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23 : COL = 80
  435. 8660  IF CURMOVE = 75 THEN COL = COL - 1 : IF COL < 1 THEN COL = 80 : ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1 : COL = 1
  436. 8670  IF CURMOVE = 80 THEN ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23
  437. 8680  IF CURMOVE = 72 THEN ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1
  438. 8685  IF CURMOVE = 83 THEN LOCATE ROW,COL : IF COLORFORE = 15 THEN COLOR FG,BG : PRINT "_";
  439. 8690  GOTO 8520
  440. 8700  VALDATUM = ASC(DATUM$)
  441. 8710  IF VALDATUM = 9 THEN COLOR COLORFORE,BG : LOCATE ROW,COL : PRINT CHR$(CHARACTER) : READ ROW,COL,LENDATA : IF ROW = 1 THEN RETURN ELSE GOTO 8500
  442. 8720  IF VALDATUM = 13 THEN RETURN
  443. 8730  IF VALDATUM < 31 OR VALDATUM > 127 THEN GOTO 8760
  444. 8740  LOCATE ROW,COL : COLOR HI,BG : PRINT DATUM$;
  445. 8750  COL = COL + 1 : IF COL > 80 THEN COL = 1 : ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23 : COL = 80
  446. 8760  IF VALDATUM = 8 THEN LOCATE ROW,COL : COLOR FG,BG : PRINT "_"; : COL = COL - 1 : IF COL < 1 THEN COL = 80 : ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1 : COL = 1
  447. 8770  GOTO 8520
  448. 8790  '
  449. 8800  '   ***   Read data from screen   ***
  450. 8810  '
  451. 8820  FOR I = 1 TO 10
  452. 8830    SCREENDATA$(I) = "" : READ ROWDATA, COLDATA, LENDATA
  453. 8840    FOR J = 0 TO LENDATA -1
  454. 8850      SCREENDATA$(I) = SCREENDATA$(I) + CHR$(SCREEN(ROWDATA,COLDATA+J))
  455. 8860    NEXT J
  456. 8870  NEXT I
  457. 8880  RETURN
  458. 8890  '
  459. 8900  '   ***   Data statements for form data locations   ***
  460. 8910  '
  461. 8920  DATA 4,13,20,4,44,1,4,62,16,6,10,34,8,7,18,8,37,2,8,49,5
  462. 8930  DATA 10,8,16,12,15,8,14,17,8,1,1,1
  463. 8980  '
  464. 8990  '   *************************************
  465. 9000  '   ***   Miscellaneous Subroutines   ***
  466. 9010  '   *************************************
  467. 9090  '
  468. 9100  '   ***   Process Yes/No Inputs   ***
  469. 9110  '
  470. 9115  ENTRY$ = INKEY$
  471. 9120  ENTRY$ = INKEY$ : IF ENTRY$ = "" THEN 9120
  472. 9130  IF ENTRY$ = "Y" OR ENTRY$ = "y" THEN YES = 1 ELSE YES = 0
  473. 9140  IF YES = 1 THEN PRINT "Yes" ELSE PRINT "No"
  474. 9150  RETURN
  475. 9190  '
  476. 9200  '   ***   Select keyfield for printing labels   ***
  477. 9210  '
  478. 9220  CLS : PRINT : PRINT "     You may print labels selectively, based on the ten data fields stored in"
  479. 9230  PRINT "each record.  Select your key field, then specify the key.  For example, if"
  480. 9240  PRINT "you select a keyfield of `City' and a key of `Detroit', then only people"
  481. 9250  PRINT "living in Detroit will have their labels printed."
  482. 9260  PRINT "     The last two fields, activity and membership, are intended so that you can"
  483. 9270  PRINT "mail to only people with a specific interest or members of a specific club."
  484. 9280  PRINT "A good system is to assign a single letter of the alphabet as the key for each"
  485. 9290  PRINT "interest or organization on your list, allowing up to eight keys per name."
  486. 9300  PRINT : PRINT TAB(20) "Key fields are: ";CHR$(13);"     1.  First name";CHR$(13);"     2.  Middle Initial";CHR$(13);"     3.  Last Name"
  487. 9310  PRINT "     4.  Address";CHR$(13);"     5.  City";CHR$(13);"     6.  State";CHR$(13);"     7.  Zip code"
  488. 9320  PRINT "     8.  Phone #";CHR$(13);"     9.  Activity Key";CHR$(13);"    10.  Membership key"
  489. 9330  PRINT : INPUT "Input number of keyfield"; KEYFIELD
  490. 9340  KEYFIELD = INT(KEYFIELD) : IF KEYFIELD < 1 OR KEYFIELD > 10 THEN PRINT "Only use keyfield between 1 and 10, please." : GOTO 9310
  491. 9350  RETURN
  492. 9390  '
  493. 9400  '   ***   Sort Subroutine   ***
  494. 9410  '
  495. 9420  FOR I = 2 TO LASTRECORD
  496. 9430    IF SORT$(I) > SORT$(I-1) THEN 9560       '   skip if already in order
  497. 9450      FOR J = I-1 TO 0 STEP -1               '   find place to insert
  498. 9460      IF SORT$(I) > SORT$(J) THEN 9500
  499. 9470      NEXT J
  500. 9480    GOTO 9560
  501. 9500    TEMP$ = SORT$(I) : TEMP = SORT(I)        '   hold item to insert
  502. 9510    FOR K = I TO J+2 STEP -1                 '   bump others up
  503. 9520      SORT$(K) = SORT$(K-1) : SORT(K) = SORT(K-1)
  504. 9530    NEXT K
  505. 9540    SORT$(J+1) = TEMP$ : SORT(J+1) = TEMP    '   Insert index item
  506. 9560  NEXT I
  507. 9570  RETURN
  508. 9590  '
  509. 9600  '   ***   Delete index & record of deleted item   ***
  510. 9610  '
  511. 9620  COLOR FG, BG : GOSUB 8100   '   write blank form
  512. 9630  LOCATE 15,1 : PRINT SPACE$(80) : LOCATE 17,1 : PRINT SPACE$(80) : PRINT TAB(20) "DELETE RECORD . . .  Are you sure (y/n)? ";
  513. 9640  GOSUB 9100
  514. 9650  IF YES = 0 THEN RETURN 9810
  515. 9660  RESTORE : GOSUB 8800 : GOSUB 6100   '   Write blanks to disc
  516. 9670  GOSUB 1800     '   Add record # to free record list
  517. 9680  RETURN 9810
  518. 9690  '
  519. 9700  '   ***   Edit record   ***
  520. 9710  '
  521. 9730  CLS : MENU = 0
  522. 9740  GOSUB 6300
  523. 9750  GOSUB 8100
  524. 9760  RESTORE : GOSUB 8400
  525. 9770  RESTORE : READ DUMMY, DUMMY, DUMMY : ROW = 4 : COL = 13
  526. 9780  GOSUB 8500
  527. 9790  LOCATE 22,20 : COLOR FG,BG : PRINT "Store updated data on disc (yes/no)? "; : GOSUB 9100
  528. 9800  IF YES = 1 THEN RESTORE : GOSUB 8800 : GOSUB 6100
  529. 9810  LOCATE 22,10 : COLOR FG,BG : PRINT "(Strike any key to find next record or return to menu)"
  530. 9820  DUMMY$ = INKEY$ : IF DUMMY$ = "" THEN GOTO 9820
  531. 9830  MENU = 0 : RETURN
  532. 9890  '
  533. 9900  '   ***   Error Traps   ***
  534. 9910  '
  535. 9920  IF ERR = 57 THEN 9960
  536. 9925  IF ERR = 61 THEN 9965
  537. 9930  IF ERR = 68 THEN 9970
  538. 9935  IF ERR = 70 THEN 9975
  539. 9940  IF ERR = 71 THEN 9980
  540. 9945  IF ERR = 72 THEN 9985
  541. 9950  ON ERROR GOTO 0
  542. 9960  PRINT : PRINT "Disc I/O error.  No I/O took place.  Try another disc." : GOTO 9990
  543. 9965  PRINT : PRINT "Disc full.  Your last entry was not saved." : GOTO 9990
  544. 9970  PRINT : PRINT "Device unavailable.  Check installation." : GOTO 9990
  545. 9975  PRINT : PRINT "The disc is write protected.  Your entry was not saved."
  546. 9980  PRINT : PRINT "The disc was not ready.  No I/O took place." : GOTO 9990
  547. 9985  PRINT : PRINT "Media error.  Check for bad disc.  No I/O took place." : GOTO 9990
  548. 9990  PRINT : PRINT "Press any key to restart program. "
  549. 9995  Z$ = INKEY$ : IF Z$ = "" THEN 9995 ELSE CLOSE : RUN
  550. 9999  END
  551.